home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / mswlogo3.zip / MSWLOGO.ZIP / LOGOLIB.ZIP / DEMO < prev    next >
Text File  |  1993-04-11  |  8KB  |  363 lines
  1. to demo
  2. ht
  3. pu
  4. settextsize 50
  5. repeat 36 [fd 175 setpencolor 0 repcount*8 0 label heading bk 175 rt 10]
  6. pd
  7. cs 
  8. repeat 18 [pu fd 100 pd repeat 4 [fd 50 rt 90] rt 45 pu fd 5 setfloodcolor repcount*15 0 0 fill bk 5 lt 45 bk 100 rt 20]
  9. pd
  10. cs 
  11. setpensize [2 2]
  12. repeat 72 [repeat 4 [fd 100 rt 90] setpencolor repcount*3 0 0 rt 5]
  13. pu
  14. setxy -50 -50
  15. bitcut 100 100
  16. cs
  17. pu
  18. repeat 36 [fd 150 bitpaste bk 150 rt 10]
  19. repeat 10 [scrollx 10]
  20. repeat 10 [scrolly 10]
  21. repeat 10 [scrollx -10]
  22. repeat 10 [scrolly -10]
  23. cs
  24. setpensize [1 1]
  25. rose 150 30 [pu  setx xcor + 5  pd]
  26. cs
  27. hanoi 3
  28. pd
  29. cs
  30. penpaint
  31. spiral 91 2 10 100
  32. cs
  33. setpensize [1 1]
  34. win
  35. end
  36.  
  37. to rose :size :petalcount :function
  38. make "ctr 0
  39. do.while ~
  40.    [ ~
  41.    line :size ~
  42.    rt 360 / :petalcount ~
  43.    make "ctr :ctr + 1 ~
  44.    run :function ~
  45.    ] ~
  46.    [:ctr < :petalcount]
  47. end
  48.  
  49. to line :length
  50. fd :length / 2
  51. pu
  52. bk :length
  53. pd
  54. fd :length / 2
  55. end
  56.  
  57. to hanoi :number 
  58. ;
  59. ; Towers of Hanoi
  60. ; Meyer A. Billmers
  61. ; November, 1983
  62. ;
  63. ; This procedure plays a graphic version of the Towers of Hanoi puzzle
  64. ; The argument is the number of disks in the configuration.
  65. ;
  66. ; c.f. putdisk, towercnt,towerset, hanoihlpr
  67. ; 
  68. local "from
  69. local "to
  70. local "other
  71. local "datfil
  72. ;make "datfil openw "hanoi.dat
  73. ;fileprint :datfil (sentence [Hanoi of ] :number [towers Started at: ] time)
  74. ; to change the starting and ending needles, change the next three assignments
  75. make "from 1
  76. make "to 3
  77. make "other 2
  78. cs
  79. ht
  80. penpaint
  81. setpensize [5 5]
  82. ; first we draw the table and the golden needles
  83. setpencolor 255 0 0
  84. pu
  85. setxy -350 -100
  86. pd
  87. setxy 350 -100
  88. pu
  89. setx -240
  90. pd
  91. fd 250
  92. pu
  93. setxy -15 -100
  94. pd
  95. fd 250
  96. pu
  97. setxy 210 -100
  98. pd
  99. fd 250
  100. make "tower1 0
  101. make "tower2 0
  102. make "tower3 0
  103. ; draw the initial stack of disks. note that putdisk draws the 
  104. ; "fixed up" towers.
  105. repeat :number ~
  106.    [~
  107.    putdisk :from :number - repcount + 1 "final ~
  108.    ifelse :from = 1 ~
  109.       [make "tower1 :tower1 + 1] ~
  110.       [ifelse :from = 2 ~
  111.          [make "tower2 :tower2 + 1] ~
  112.          [make "tower3 :tower3 + 1] ~
  113.       ] ~
  114.    ]
  115. hanoihlpr :number :from :to :other
  116. ; fileprint :datfil (sentence [Hanoi Ended at: ] time)
  117. ; close :datfil
  118. end
  119.  
  120. to hanoihlpr :number :from :to :other
  121. ;
  122. ; Called by HANOI. Contains the actual recursive Towers of Hanoi algorithm
  123. ;
  124. local "tcf 
  125. local "tct
  126. if equalp :number 0 [stop]
  127. hanoihlpr :number-1 :from :other :to
  128. make "tcf towercnt :from
  129. make "tct towercnt :to
  130. towerset :from :tcf - 1
  131. putdisk :from :number "temp
  132. putdisk :to :number "temp
  133. putdisk :from :number "erase
  134. putdisk :to :number "final
  135. towerset :to :tct + 1
  136. hanoihlpr :number-1 :other :to :from
  137. end
  138.  
  139. to putdisk :tnum :dnum :state
  140. ;
  141. ; Called by HANOI to put a disk on a tower.
  142. ; first arg. is number of tower (1,2 or 3)
  143. ; second arg. is number of disk to draw (1 is smallest)
  144. ; third arg. is "final, "temp, or "erase depending on whether
  145. ;   disk is drawn in final state, in temporary state to indicate
  146. ;   motion, or is being erased (removed from this tower)
  147. ; Note that this procedure re-draws the tower correctly.
  148. ;
  149. local "tc
  150. local "halfsize
  151. make "tc towercnt :tnum
  152. make "halfsize sum 20 product :dnum 10
  153. pu
  154. ifelse :tnum = 1 ~
  155.    [setxy "-240 "-100] ~
  156.    [ ~
  157.    ifelse :tnum = 2 ~
  158.       [setxy "-15 "-100] ~
  159.       [setxy 210 "-100] ~
  160.    ]
  161. pe
  162. fd product 30 :tc
  163. pu
  164. setxy xcor - :halfsize ycor
  165. pd
  166. penpaint
  167. ifelse :state = "final ~
  168.    [setpencolor 0 255 0] ~
  169.    [ ~
  170.    ifelse :state = "temp ~
  171.       [setpencolor 0 0 255] ~
  172.       [pe] ~
  173.    ]
  174. fd 30
  175. rt 90
  176. fd product :halfsize 2
  177. rt 90
  178. fd 30
  179. rt 90
  180. pu
  181. fd :halfsize
  182. rt 90
  183. setpencolor 255 0 0
  184. ifelse :state = "erase ~
  185.    [ ~
  186.    pd ~
  187.    penpaint ~
  188.    fd 30 ~
  189.    ] ~
  190.    [ ~
  191.    pe ~
  192.    fd 30 ~
  193.    ]
  194. end
  195.  
  196. to towercnt :tn
  197. ;
  198. ; Called by HANOI. Returns the current number of disks on tower :tn,
  199. ; as stored in the globals tower1, tower2, and tower3.
  200. ;
  201. ifelse :tn = 1 ~
  202.    [output :tower1] ~
  203.    [ ~
  204.    ifelse :tn = 2 ~
  205.       [output :tower2] ~
  206.       [output :tower3] ~
  207.    ]
  208. end
  209.  
  210. to towerset :tn :value
  211. ;
  212. ; Called by HANOI. Sets the current number of disks on tower :tn,
  213. ; as stored in the globals tower1, tower2, and tower3.
  214. ;
  215. ifelse :tn = 1 ~
  216.    [make "tower1 :value] ~
  217.    [ ~
  218.    ifelse :tn = 2 ~
  219.       [make "tower2 :value] ~
  220.       [make "tower3 :value] ~
  221.    ]
  222. end
  223.  
  224. to spiral :angle :repeat :incr :segs
  225. ;; 
  226. ;; Spirals, by Meyer A. Billmers
  227. ;;  
  228. ;; This procedure makes pretty spirals. I suggest you first do a 
  229. ;; hideturtle so the drawing will proceed at a reasonable rate.
  230. ;; 
  231. ;; angle   is the amount of turn at each piece, 
  232. ;; repeat  is the number of turns before the distance is incremented, and
  233. ;; incr    is the amount of distance increment.
  234. ;; 
  235. ;; Suggested fun spirals:
  236. ;;     spiral 90 2 10
  237. ;;     spiral 91 2 10
  238. ;;     spiral 60 3 10
  239. ;;     spiral 61 3 10
  240. ;;     spiral 179 2 5
  241. ;;     spiral 20 10 4
  242. ;; 
  243. make "len :incr
  244. make "ctr 0
  245. repeat :segs ~
  246.   [ ~
  247.   fd :len ~
  248.   rt :angle ~
  249.   make "ctr :ctr + 1 ~
  250.   if :ctr = :repeat ~
  251.      [ ~
  252.      make "ctr 0 ~
  253.      make "len :len + :incr ~
  254.      ] ~
  255.   ]
  256. end
  257.  
  258. to win
  259. make "cmw 75
  260. make "cmh 30
  261. make "sth 12
  262. make "lsw :cmw
  263. make "lsh 20
  264. make "scw 10
  265. make "sch 40
  266. make "btw 50
  267. make "bth 12
  268. make "gapx 6
  269. make "gapy 6
  270. make "mary 2
  271. make "wnx 180
  272. make "wny 120
  273. make "wnx2 :wnx / 2
  274. make "wny2 :wny / 2
  275. make "wnx3 :wnx / 3
  276. make "wny3 :wny / 3
  277. make "wnx6 :wnx / 6
  278. make "wny6 :wny / 6
  279. make "st2w 30
  280. make "row2 :wny3+:gapy
  281. make "row3 :wny3*2-:gapy/2
  282.  
  283. windowcreate "main "d1 [This is a Demo Windows Application] 0 0 :wnx+:gapy :wny+:gapy
  284.  
  285. staticcreate "d1 "st2 [Run mode] :gapx :mary :cmw :sth
  286. groupboxcreate "d1 "g1 :gapx :sth+:mary :cmw :cmh
  287. checkboxcreate "d1 "g1 "cb1 [Hide Turtle] :gapx+:gapx :sth+:mary+:gapy :btw :bth
  288. checkboxcreate "d1 "g1 "cb2 [Status]      :gapx+:gapx :sth+:mary+:bth+4 :btw :bth
  289.  
  290. staticcreate "d1 "st3 [Select Post-Command] :wnx2+:gapx :mary :cmw :sth
  291. comboboxcreate "d1 "c2 :wnx2+:gapx :sth+:mary :cmw :cmh
  292. comboboxaddstring "c2 [RT 2]
  293. comboboxaddstring "c2 [RT 5]
  294. comboboxaddstring "c2 [RT 10]
  295. comboboxsettext "c2 [RT 5]
  296.  
  297. staticcreate "d1 "st4 [Select Shape] :gapx :row2 :lsw :sth
  298. listboxcreate "d1 "l1 :gapx :row2+:sth+1 :lsw :lsh
  299. listboxaddstring "l1 "SQUARE
  300. listboxaddstring "l1 "TRIANGLE
  301. listboxaddstring "l1 "HEXAGON
  302.  
  303. staticcreate "d1 "st11 "Red :wnx6*3+:gapx :row2 :st2w :sth
  304. scrollbarcreate "d1 "s1 :wnx6*3+:gapx :row2+:sth :scw :sch [myred]
  305. scrollbarset "s1 1 255 125 myred
  306.  
  307. staticcreate "d1 "st12 "Grn :wnx6*4+:gapx :row2 :st2w :sth
  308. scrollbarcreate "d1 "s2 :wnx6*4+:gapx :row2+:sth :scw :sch [mygreen]
  309. scrollbarset "s2 1 255 125 mygreen
  310.  
  311. staticcreate "d1 "st13 "Blue :wnx6*5+:gapx :row2 :st2w :sth
  312. scrollbarcreate "d1 "s3 :wnx6*5+:gapx :row2+:sth :scw :sch [myblue]
  313. scrollbarset "s3 1 255 125 myblue
  314.  
  315. staticcreate "d1 "st14 [Repeat Count] :gapx :row3 :sch*2 :sth
  316. scrollbarcreate "d1 "s4 :gapx :row3+:sth :sch*2 :scw [myrepeat]
  317. scrollbarset "s4 1 360 72 myrepeat
  318.  
  319. buttoncreate "d1 "b1 "END :gapx :wny-:bth-:gapy :btw :bth [myend]
  320. buttoncreate "d1 "b3 "CLEAR :wnx2-:btw/2 :wny-:bth-:gapy :btw :bth [cs]
  321. buttoncreate "d1 "b2 "DRAW :wnx-:btw-:gapx :wny-:bth-:gapy :btw :bth [drawthing]
  322. end
  323.  
  324. to drawthing
  325. setpencolor scrollbarget "s1 scrollbarget "s2 scrollbarget "s3
  326. ifelse checkboxget "cb1 [ht] [st]
  327. ifelse checkboxget "cb2 [status] [nostatus]
  328. repeat scrollbarget "s4~
  329.   [~
  330.   if equalp "HEXAGON listboxgetselect "l1 [repeat 6 [fd 100 rt 60]]~
  331.   if equalp "SQUARE listboxgetselect "l1 [repeat 4 [fd 100 rt 90]]~
  332.   if equalp "TRIANGLE listboxgetselect "l1 [repeat 3 [fd 100 rt 120]]~
  333.   run comboboxgettext "c2~
  334.   ]
  335. end
  336.  
  337. to myblue
  338. staticupdate "st13 sentence [Blue] scrollbarget "s3
  339. end
  340.  
  341. to myend
  342. windowdelete "d1
  343. end
  344.  
  345. to mygreen
  346. staticupdate "st12 sentence [Grn] scrollbarget "s2
  347. end
  348.  
  349. to mynil
  350. end
  351.  
  352. to myred
  353. staticupdate "st11 sentence [Red] scrollbarget "s1 
  354. end
  355.  
  356. to myrepeat
  357. staticupdate "st14 sentence [Repeat Count] scrollbarget "s4 
  358. end
  359.  
  360. to mystatic
  361. staticupdate "st14 sentence [Repeat Count] scrollbarget "s4 
  362. end
  363.